home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Yerk 3.6.7 / yerk 367 / System source / PathList < prev    next >
Text File  |  1994-11-29  |  6KB  |  157 lines
  1. \  7/04/86  cdn A general class to maintain lists of paths
  2. \  7/09/86  cdn Added getPtxt
  3. \  9/26/86  rfd added GET:
  4. \ 12/29/90    rfl    now part of sarray
  5. \  1/02/90    rfl    added check for >255 in (count)
  6. \  4/10/91    rfl    fixed to: with @sarray change to return offset
  7. \ 11/29/94    rfl    fixed small bug in (count) where sometimes size=n+1
  8.  
  9. \ Class Sarray - string array
  10. \        used just like an array, but with arbitrary length elements.
  11. \        Each element is a pascal string.
  12. \ 11.26.90    rfl    cleared size with new:  
  13. \ 11.28.90    rfl fixed at: sarray by get: size 1-
  14. hex
  15. \ limits checked at high level
  16. create @Sarray    ( ind startAddr -- addr len offset )
  17.     4281 w,                \        clr.l    d1
  18.     205F w,                \        movea.l    (sp)+,a0    \ get start addr
  19.     2248 w,                \        movea.l    a0,a1        \ make a copy
  20.     201F w,                \        move.l    (sp)+,d0    \ get index
  21.     D1CB w,                \        adda.l    a3,a0        \ convert to abs addr
  22.     1218 w,                \ loop    move.b    (a0)+,d1    \ get len
  23.     5380 w,                \        subq.l    #1,d0        \ dec index
  24.     0C80 w,    ffffffff ,    \        cmpi.l    #-1,d0        \ time to get out
  25.     6700 w,    0008 w,        \        beq        out
  26.     D1C1 w,                \        adda.l    d1,a0        \ go to next index
  27.     6000 w,    ffee w,        \        bra loop
  28.     91CB w,                \ out    suba.l    a3,a0        \ get rel addr
  29.     2F08 w,                \        move.l    a0,-(sp)
  30.     2F01 w,                \        move.l    d1,-(sp)
  31.     91c9 w,                \        suba.l    a1,a0        \ get offset from start
  32.     5388 w,                \        subq    #1,a0        \ less one
  33.     2f08 w,                \        move.l    a0,-(sp)
  34. next,
  35.  
  36. \ counts the number of items in an sarray format
  37. create SCount    ( addr len -- n)
  38.     4281 w,                \        clr.l    d1
  39.     241F w,                \        move.l    (sp)+,d2
  40.     2057 w,                \        movea.l    (sp),a0
  41.     D1CB w,                \        adda.l    a3,a0
  42.     2248 w,                \        movea.l    a0,a1
  43.     D3C2 w,                \        adda.l    d2,a1        \ stop addr
  44.     1010 w,                \ loop    move.b    (a0),d0
  45.     D1C0 w,                \        adda.l    d0,a0
  46.     5288 w,                \        addq    #1,a0
  47.     5281 w,                \        addq    #1,d1        \ inc counter
  48.     B3C8 w,                \        cmp.l    a0,a1        \ time to stop
  49.     6E00 w,    fff4 w,        \        bgt        loop
  50.     2E81 w,                \        move.l    d1,(sp)
  51. next,
  52.  
  53. \ If the list is a list of items separated by a delimeter, then this word
  54. \  searches through list, finds delimeters and replaces with the count to
  55. \  bring it to sarray format. Proceeds to end of string with or without a delimeter there
  56. create (count)            \ ( addr len delimeter -- count)
  57.     4282 w,                \        clr.l    d2            \ count
  58.     261F w,                \        move.l    (sp)+,d3    \ char
  59.     2C1F w,                \        move.l    (sp)+,d6    \ len
  60.     2057 w,                \        movea.l    (sp),a0        \ addr
  61.     D1CB w,                \        adda.l    a3,a0
  62.     5288 w,                \        addq    #1,a0        \ start after first count byte
  63.     5386 w,                \        subq.l    #1,d6        \ and therefore one less to go
  64.     2248 w,                \        movea.l    a0,a1        \ store start
  65.     B618 w,                \ start    cmp.b    (a0)+,d3    \ compare first char with delimeter
  66.     6600 w, 0022 w,        \        bne        noadd        \ if no match, continue
  67.     5282 w,                \        addq    #1,d2        \ else, increment count
  68.     2008 w,                \        move.l    a0,d0
  69.     9089 w,                \        sub.l    a1,d0
  70.     5380 w,                \        subq    #1,d0
  71.     b07c w, 00ff w,        \        cpi.w    #255,d0        \ make sure element is <255
  72.     6d00 w, 000c w,        \        blt        ok
  73.     2ebc w, ffffffff ,    \        move.l    #-1,(sp)    \ put -1 on stack if illegal
  74.     6000 w, 0010 w,        \        bra        out
  75.     1340 w,    ffff w,        \        move.b    d0,-1(a1)    \ get size and put into location
  76.     2248 w,                \        movea.l    a0,a1        \ get new size location
  77.     5386 w,                \ noadd    subq.l    #1,d6        \ one less to go
  78.     6E00 w,    ffd6 w,        \        bgt        start        \ continue until zero
  79.     2E82 w,                \        move.l    d2,(sp)        \ store count on stack
  80.                         \ out    
  81. next,
  82.  
  83. decimal
  84.  
  85. \ class of ordered-col of strings. format is str255str255.....str255
  86. :CLASS sarray <super string
  87.  
  88.   var    size        \ # of elements in array
  89.   int    delimeter
  90.  
  91. \ clearing size prevents problems when image is saved with size set nonzero
  92.   :M new: new: super clear: size ;M
  93.  
  94. \ returns # of elements
  95.   :M limit: ( -- n) get: size ;M
  96.  
  97.   :M putLimit: ( n --) put: size ;M
  98.  
  99.   :M putChar: ( n --) put: delimeter ;M
  100.  
  101. \ if want to go faster, remove range checking
  102.   :M at: ( ind -- addr len) dup get: size 1- > >r dup 0< r> or classerr" 129 ptr: self @sarray
  103.         put: offset ;M
  104.  
  105.   :M ^elem: ( ind -- addr) at: self drop 1- ;M
  106.  
  107.   :M print: limit: self 0 DO i . i at: self type cr ?pause LOOP ;M
  108.  
  109.   :M indexOf: { addr len \ flag -- ind t or f }
  110.     limit: self 0 false -> flag
  111.     DO addr len i at: self s= IF i true -> flag LEAVE THEN LOOP
  112.     flag ;M
  113.  
  114.   :M remove: ( ind -- )
  115.     ^elem: self dup ptr: self - put: offset
  116.     dup c@ 1+ delete: super -1 +: size ;M
  117.  
  118.   :M to: { addr len ind -- } ind at: self
  119.     swap 1- swap 1+ addr len str255 -base len 1+ replace: self ;M
  120.  
  121.   :M add: { addr len -- } len 255 > classerr" 135
  122.     len +: super addr len add: super 1 +: size ;M
  123.  
  124.   :M clear: clear: super clear: size ;M
  125.  
  126.   :M =: { anotherSarray -- } getState: super lock: self
  127.         get: self put: anotherSarray setState: self
  128.         limit: self putLimit: anotherSarray ;M
  129.  
  130. \ given the addr len of an sarray format list on the stack, put into an object
  131.   :M put: ( addr len --) put: super get: self scount put: size ;M
  132.  
  133. \ use for delimeted string, thus far uncounted. If already in format, don't use
  134.   :M count: get: self + 1- c@ get: delimeter <>
  135.         IF get: delimeter +: self THEN
  136.         start: self pad 1 insert: self
  137.         get: self get: delimeter (count) put: size
  138.         size: self 1- setsize: self get: size 0< classerr" 135 ;M
  139.  
  140. \ use instead of put:
  141. \ assuming the data is delimited by some character, as in the following format:
  142. \ dddd|dd|dddd|dddd|
  143. \ where d is data and | is the delimeter - last element doesn't need trailing delimeter
  144. \ modify to the sarray format.
  145.   :M place: ( addr len --) put: super count: self ;M
  146.  
  147. ;CLASS
  148.  
  149. \ ( addr len -- )  Setup path string from text file
  150. : getPtxt     new: loadFile  name: topFile
  151.     OpenReadOnly: topFile ?error 179
  152.     path IF release: path dispose> path THEN
  153.     heap> sarray -> path new: path 13 putChar: path
  154.     topfile size: topfile read: path drop
  155.     count: path
  156.     remove: loadFile ;
  157.